home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_200 / 297_01 / prlush.c < prev    next >
C/C++ Source or Header  |  1991-12-30  |  28KB  |  1,031 lines
  1. /* prlush.c */
  2. /* Lush resolution .
  3.  * Along with unification these are the most important routines in Prolog.
  4.  * If you want to embed Small Prolog then you won't need query_loop as such.
  5.  * See Chris Hogger's "An Introduction to Logic Programming" (Academic Press)
  6.  * if you are hungry for more explanation.
  7.  */
  8. /* Small Prolog uses a control stack , a substitution stack and a 
  9.  * "trail" to represent its run-time state.
  10.  * The control stack is the stack of "activation records".
  11.  * A clause packet is the linked list of clauses that correspond to
  12.  * a predicate. It's prolog's equivalent of a procedure.
  13.  * You enter a procedure when a goal is unified successfully with the
  14.  * head of a clause. You can enter the procedure at different clauses.
  15.  * Execution tries the clauses in the order of their occurence in the
  16.  * list.
  17.  * Each time a procedure (clause packet) is entered, a corresponding "frame"
  18.  * (or what is called "activation record" in languages like C)
  19.  * is pushed on the control stack, and a corresponding frame is pushed
  20.  * on the substitution stack(representing the parameters).
  21.  * However the situation is much more complicated than what occurs in 
  22.  * familiar languages because a procedure might have to be redone
  23.  * (with the next clause of the packet) after exit of the procedure.
  24.  * So you cant just pop the frame on successful return.
  25.  * Popping the frame only occurs on backtracking, unless you implement
  26.  * an optimisation that recognises that no more clauses could be tried.
  27.  * I have not implemented this optimisation in the current version, sorry.
  28.  
  29. *  Each frame must remember its parent: a pointer to the frame of
  30.  * the clause which contains the goal that led to the current clause.
  31.  * This is used when every goal of the clause has been successfully solved.
  32.  * This is not necessarily the previous frame because the previous frame 
  33.  * comes from the elder brother goal.
  34.  * We need to remember also the next goal to try if the current goal
  35.  * ends up being successful.
  36.  * We need to remember the last "backtrack point": this is a frame
  37.  * where there seemed to be the possibility of another solution
  38.  * for its procedure.
  39.  * We backtrack to that point when there is a failure.
  40.  * There is a global variable that does this. But this variable
  41.  * will have to be updated when we backtrack so we need to save
  42.  * the previous values of it on the stack too. To save a little
  43.  * space only some frames need to store the last backtrack point,
  44.  * These are "non-deterministic frames", frames in which there
  45.  * was a remaining candidate to the current clause.
  46.  * Sometimes substitions are created low in the substitution stack
  47.  * -before the environment of the current goal. This is why
  48.  * we use a trail to be able to unset these substitutions on backtracking.
  49.  * We have been lazy and recorded all substitutions on the 
  50.  * trail.
  51.  */
  52.     
  53.    
  54.  
  55. #include <stdio.h>
  56. #include <setjmp.h> /* added this on Dec 21 1991 */
  57. #include <assert.h>  /* added this on Dec 21 1991 */
  58. #include "prtypes.h"
  59. #include "prlush.h"
  60.  
  61.  
  62. #define NOTVARPRED "A variable can't be used as a predicate\n"
  63. #define NOPRED "Predicate not atom\n"
  64. #define STACKCONTENTS "Ancestors of current goal:\n"
  65. #define INIQUERY "Syntax error ini initial query"
  66. #define STRINGQUERY "Syntax error ini query passed as string"
  67.  
  68. #if TRACE_CAPABILITY
  69. /*  values of where in tracing */
  70. #define G_BTK          'B' /* goto bactrack */
  71. #define G_AGA        'P' /* goto AGAIN */
  72. #define KEEP_GOING    'K'
  73.  
  74. #define TRACE(X) if(Trace_flag > 0){\
  75.          if(X == 0)return ABNORMAL_LUSH_RETURN;\
  76.         switch(where){case G_AGA:goto AGAIN;case G_BTK:goto BACKTRACK;}}
  77.          
  78. #define CAN_SKIP 1
  79. #define CANT_SKIP 0
  80. #else
  81. #define TRACE(X)
  82. #endif
  83.  
  84. /* Although the Trace_flag can be set by a builtin
  85.    actual tracing can be suspended while stepping over a call .
  86.   The following two variables are used for this purpose.
  87.  */
  88. static int Copy_tracing_now;
  89.  
  90. #ifdef HUNTBUGS
  91.     extern int Bug_hunt_flag;
  92. #endif
  93.  
  94.  
  95. extern subst_ptr_t DerefSubst; /* enviroment of last dereferenced 
  96.                 object  */
  97. extern subst_ptr_t my_Subst_alloc();
  98. extern node_ptr_t DerefNode; /* skeleton of last dereferenced object */
  99. extern node_ptr_t NilNodeptr; /* node corresponding to empty list */
  100. extern atom_ptr_t Nil;        /* object  of empty list */
  101. extern clause_ptr_t Bltn_pseudo_clause;
  102. extern dyn_ptr_t HighDyn_ptr,Dyn_mem, Dyn_ptr, my_Dyn_alloc(); /* for control stack */
  103. extern subst_ptr_t Subst_mem, Subst_ptr; /* for substitution stack */
  104. extern node_ptr_t **Trail_mem, **Trail_ptr;
  105. extern FILE * Curr_outfile;
  106.  
  107.  
  108. void ini_lush(), reset_zones();
  109.  
  110. clause_ptr_t Curr_clause; /* current clause containing Goals */
  111. clause_ptr_t Candidate;   /*Used when we look for a clause whose
  112.              head might match goal */
  113. dyn_ptr_t QueryCframe;   /* Control frame of Query */
  114. dyn_ptr_t LastCframe; /* most recent Cframe */
  115. dyn_ptr_t LastBack; /* points to cframe of most recent backtrack point */
  116. dyn_ptr_t Parent;   /* parent Cframe of current goal */
  117. dyn_ptr_t BackFrame; /* parent frame in case of reverse tracing */
  118. node_ptr_t Goals; /* what remains of current goals of the clause.
  119.             The head of the list is the goal to satisfy first.
  120.             Note that there will be (in general) other goals to 
  121.             satisfy on completion of solution of Goals
  122.          */
  123. node_ptr_t Query; /* the initial query */
  124. node_ptr_t Arguments;/* arguments of current goal (points to a list) */
  125. subst_ptr_t Subst_goals, /* substituion env of Goals         */
  126. SubstGoal, /* can be different to Subst_goals if there is a "call" */
  127. OldSubstTop; /* for backtracking */
  128. atom_ptr_t Predicate; /* predicate of current goal     */
  129. node_ptr_t **OldTrailTop;
  130. int ErrorGlobal; /* used to communicate the fact there was an error */
  131. int Deterministic_flag; /*used to minimise "more?" questions after a solution */
  132. int ReverseTraceMode = 0; /* if set to 1 means you can trace backwards 
  133.               but this is greedy on control stack space 
  134.               because all frames are like the non-deterministic
  135.               frames.
  136.             */
  137. integer Nunifications = 0; /* just for statistics */
  138.  
  139. /******************************/
  140. /* Dec 21 1991 new variables: */
  141. /******************************/
  142.  
  143. node_ptr_t ND_builtin_next_nodeptr;/* This is for 
  144.     non deterministic builtins. When this variable is NULL it
  145.     is the first call of the predicate. Otherwise it is the nodeptr
  146.      that guides the non deterministic builtin.
  147.     */
  148. jmp_buf Bltin_env; /* see do_builtin() */
  149. jmp_buf Query_jenv; /* see query_loop() */
  150. int QJusable = 0; /* Determines if we can longjump to Query_jenv */
  151.  
  152. #if TRACE_CAPABILITY
  153. extern int Trace_flag; /* sets trace mode */
  154. extern int Tracing_now; /* sets trace mode */
  155. dyn_ptr_t Skip_above;
  156. int Unleash_flag = 0;
  157. #endif
  158.  
  159.  
  160. /*******************************************************************
  161.         read_goals()
  162.  Called by query_loop.
  163.  Updates Goals, Nvars and Query. 
  164.  *******************************************************************/
  165. read_goals(ifp)
  166. FILE *ifp;
  167. {
  168.     extern node_ptr_t read_list(), get_node();
  169.     extern FILE * Curr_infile;
  170.  
  171.     node_ptr_t head;
  172.     FILE * save_cif;
  173.  
  174.     ENTER("read_goals");
  175.     save_cif = Curr_infile;
  176.     Curr_infile = ifp;
  177.     Goals = read_list(PERMANENT);
  178.     if(Goals == NULL)return(0);
  179.     copy_varnames();
  180.     head = NODEPTR_HEAD(Goals);
  181.  
  182.     if(NODEPTR_TYPE(head) == ATOM)
  183.     {
  184.         pair_ptr_t pairptr, get_pair();
  185.  
  186.         pairptr = get_pair(DYNAMIC);
  187.         NODEPTR_TYPE(PAIRPTR_HEAD(pairptr)) = PAIR;
  188.         NODEPTR_PAIR(PAIRPTR_HEAD(pairptr)) = NODEPTR_PAIR(Goals);
  189.         NODEPTR_TYPE(PAIRPTR_TAIL(pairptr)) = ATOM;
  190.         NODEPTR_ATOM(PAIRPTR_TAIL(pairptr)) = Nil;
  191.         Goals = get_node(DYNAMIC);
  192.         NODEPTR_TYPE(Goals) = PAIR;
  193.         NODEPTR_PAIR(Goals) = pairptr;
  194.     }
  195.  
  196.     Query = Goals;
  197.     Curr_infile = save_cif;
  198.  
  199.     return(1);
  200. }
  201.  
  202.  
  203. /******************************************************************************
  204.             initial_query
  205.  This executes the query from a file . It is silent if the file does not exist.
  206.  ******************************************************************************/
  207. initial_query(filename)
  208. char *filename;
  209. {
  210.     FILE *ifp;
  211.     
  212.     ENTER("initial_query");
  213.     if((ifp = fopen(filen